home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SWAG / SWAGA_C / COMM.SWG / 0028_Small,Good ASYNC routines.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-26  |  8KB  |  255 lines
  1. {$B-} { Short circuit boolean ON }
  2. {$I-} { I/O checking OFF }
  3. {$R-} { Range checking OFF }
  4. {$S-} { Stack checking OFF }
  5. {$V-} { Var-str checking OFF}
  6.  
  7. UNIT ASYNC2;
  8.   {PD async unit debugged and modified for doorgame use by Joel Bergen}
  9.   {added com3 & com4 support and xon/xoff handshaking                 }
  10.   {various bug fixes by Gary Gordon & Joel Bergen Jan 1990}
  11.   {Last revised:  1/14/90}
  12.   {still needs check for existance of comm port in Async_Open routine}
  13.  
  14. INTERFACE
  15.  
  16. USES DOS, CRT;
  17.  
  18. VAR
  19.   Async_CheckCTS  : BOOLEAN;
  20.  
  21. PROCEDURE Async_Init;
  22.   { initialize variables, call first to initialize }
  23.  
  24. PROCEDURE Async_Close;
  25.   { reset the interrupt system when UART interrupts no longer needed }
  26.   { Turn off the COM port interrupts.                                }
  27.   { **MUST** BE CALLED BEFORE EXITING YOUR PROGRAM; otherwise you    }
  28.   { will see some really strange errors and have to re-boot.         }
  29.  
  30. FUNCTION Async_Open(ComPort,BaudRate : WORD) : BOOLEAN;
  31.   { open a communications port at 8/n/1 with supplied port & baud   }
  32.   { Sets up interrupt vector, initialies the COM port for           }
  33.   { processing, sets pointers to the buffer.  Returns FALSE if COM  }
  34.   { port not installed.                                             }
  35.  
  36. FUNCTION Async_Buffer_Check : BOOLEAN;
  37.   { see if a character has been received        }
  38.   { If a character is available, returns TRUE   }
  39.   { Otherwise, returns FALSE                    }
  40.  
  41. FUNCTION Async_Read : CHAR;
  42.   { read a character, assuming it is ready}
  43.  
  44. PROCEDURE Async_Send(C : CHAR);
  45.   { transmit a character }
  46.  
  47. PROCEDURE Async_Hangup;
  48.   { drop carrier by dropping DTR}
  49.  
  50. FUNCTION Async_CarrierDetect : BOOLEAN;
  51.   { true if carrier detected }
  52.  
  53. {----------------------------------------------------------------------------}
  54.  
  55. IMPLEMENTATION
  56.  
  57. CONST
  58.   I8088_IMR = $21;   { port address of the Interrupt Mask Register }
  59.   AsyncBasePort  : ARRAY[1..4] OF WORD = ($03F8,$02F8,$03E8,$02E8);
  60.   AsyncIRQ       : ARRAY[1..4] OF WORD = (4,3,4,3);
  61.   Async_Buffer_Max = 1024;          { size of input buffer }
  62.   Ier = 1;
  63.   Lcr = 3;
  64.   Mcr = 4;
  65.   Lsr = 5;
  66.   Msr = 6;
  67.  
  68. VAR
  69.   Async_OriginalVector : POINTER;
  70.   Async_OriginalLcr    : INTEGER;
  71.   Async_OriginalImr    : INTEGER;
  72.   Async_OriginalIer    : INTEGER;
  73.  
  74.   Async_Buffer         : ARRAY[0..Async_Buffer_Max] OF CHAR;
  75.  
  76.   Async_Open_Flag      : BOOLEAN;   { true if Open but no Close }
  77.   Async_Pause          : BOOLEAN;   { true if paused (Xoff received) }
  78.   Async_Port           : INTEGER;   { current Open port number (1..4) }
  79.   Async_Base           : INTEGER;   { base for current open port }
  80.   Async_Irq            : INTEGER;   { irq for current open port }
  81.  
  82.   Async_Buffer_Overflow: BOOLEAN;   { True if buffer overflow has happened }
  83.   Async_Buffer_Used    : WORD;      { number of characters in input buffer }
  84.  
  85.   { Async_Buffer is empty if Head = Tail }
  86.   Async_Buffer_Head    : WORD;   { Locn in Async_Buffer to put next char }
  87.   Async_Buffer_Tail    : WORD;   { Locn in Async_Buffer to get next char }
  88.  
  89. PROCEDURE DisableInterrupts; INLINE($FA {cli} );     {MACROS}
  90. PROCEDURE EnableInterrupts;  INLINE($FB {sti} );
  91.  
  92. PROCEDURE Async_Isr;  INTERRUPT;
  93. { Interrupt Service Routine
  94.   Invoked when the UART has received a byte of data from the
  95.   communication line }
  96. CONST
  97.   Xon  = #17;  {^q resume}
  98.   Xoff = #19;  {^s pause}
  99. VAR
  100.   c : CHAR;
  101. BEGIN
  102.   EnableInterrupts;
  103.   IF Async_Buffer_Used < Async_Buffer_Max THEN BEGIN
  104.     c := CHR(PORT[Async_Base]);
  105.     CASE c OF
  106.       Xoff : Async_Pause:=TRUE;
  107.       Xon  : Async_Pause:=FALSE;
  108.       ELSE BEGIN
  109.         Async_Pause:=FALSE;
  110.         Async_Buffer[Async_Buffer_Head] := c;
  111.         IF Async_Buffer_Head < Async_Buffer_Max THEN
  112.           INC(Async_Buffer_Head)
  113.         ELSE
  114.           Async_Buffer_Head := 0;
  115.         INC(Async_Buffer_Used);
  116.       END;
  117.     END;
  118.   END ELSE Async_Buffer_Overflow := TRUE;
  119.   DisableInterrupts;
  120.   PORT[$20] := $20;
  121. END; { Async_Isr }
  122.  
  123. PROCEDURE Async_Init;
  124. { initialize variables }
  125. BEGIN
  126.   Async_Open_Flag       := FALSE;
  127.   Async_Buffer_Head     := 0;
  128.   Async_Buffer_Tail     := 0;
  129.   Async_Buffer_Overflow := FALSE;
  130.   Async_Buffer_Used     := 0;
  131.   Async_Pause           := FALSE;
  132.   Async_CheckCTS        := TRUE;
  133. END; { Async_Init }
  134.  
  135. PROCEDURE Async_Close;
  136. { reset the interrupt system when UART interrupts no longer needed }
  137. VAR
  138.   i, m : INTEGER;
  139. BEGIN
  140.   IF Async_Open_Flag THEN BEGIN
  141.     DisableInterrupts;             { disable IRQ on 8259 }
  142.     PORT[Async_Base + Ier] := Async_OriginalIer;
  143.     PORT[Async_Base+Lcr]   := Async_OriginalLcr;
  144.     PORT[I8088_IMR]        := Async_OriginalImr;
  145.     EnableInterrupts;
  146.     SETINTVEC(Async_Irq + 8,Async_OriginalVector);
  147.     Async_Open_Flag := FALSE     { flag port as closed }
  148.   END
  149. END; { Async_Close }
  150.  
  151. FUNCTION Async_Open(ComPort,BaudRate : WORD) : BOOLEAN;
  152. VAR
  153.   i, m : INTEGER;
  154.   b    : BYTE;
  155. BEGIN
  156.     IF Async_Open_Flag THEN Async_Close;
  157.     Async_Port := ComPort;
  158.     Async_Base := AsyncBasePort[Async_Port];
  159.     Async_Irq  := AsyncIRQ[Async_Port];
  160.       { set comm parameters }
  161.     Async_OriginalLcr := PORT[Async_Base+Lcr];
  162.  
  163.     PORT[Async_Base+Lcr] := $03;  {set 8/n/1. This shouldn't be hardcoded}
  164.       { set ISR vector }
  165.     GETINTVEC(Async_Irq+8, Async_OriginalVector);
  166.     SETINTVEC(Async_Irq+8, @Async_Isr);
  167.       { read the RBR and reset any possible pending error conditions }
  168.       { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
  169.     DisableInterrupts;
  170.     PORT[Async_Base+Lcr] := PORT[Async_Base+Lcr] AND $7F;
  171.       { read the Line Status Register to reset any errors it indicates }
  172.     i := PORT[Async_Base+Lsr];
  173.       { read the Receiver Buffer Register in case it contains a character }
  174.     i := PORT[Async_Base];
  175.       { enable the irq on the 8259 controller }
  176.     i := PORT[I8088_IMR];  { get the interrupt mask register }
  177.  
  178.     Async_OriginalImr := i;
  179.  
  180.     m := (1 shl Async_Irq) XOR $00FF;
  181.     PORT[I8088_IMR] := i AND m;
  182.       { enable the data ready interrupt on the 8250 }
  183.  
  184.     Async_OriginalIer := PORT[Async_Base + Ier];
  185.  
  186.     Port[Async_Base + Ier] := $01; { enable data ready interrupt }
  187.       { enable OUT2 on 8250 }
  188.     i := PORT[Async_Base + Mcr];
  189.     PORT[Async_Base + Mcr] := i OR $08;
  190.     EnableInterrupts;
  191.       { Set baudrate}
  192.     b := PORT[Async_Base+Lcr] OR 128;
  193.     PORT[Async_Base+Lcr]:= b;
  194.     PORT[Async_Base  ]  := LO(TRUNC(115200.0/BaudRate));
  195.     PORT[Async_Base+1]  := HI(TRUNC(115200.0/BaudRate));
  196.     PORT[Async_Base+Lcr]:= b AND 127;
  197.       { set flags }
  198.     Async_Open_Flag := TRUE;
  199.     Async_Open := TRUE;
  200. END; { Async_Open }
  201.  
  202. FUNCTION Async_Buffer_Check : BOOLEAN;
  203. { return true if character ready to receive }
  204. BEGIN
  205.   Async_Buffer_Check := (Async_Buffer_Used <> 0);
  206. END; { Async_Buffer_Check }
  207.  
  208. FUNCTION Async_Read : CHAR;
  209. { return char, use Async_Buffer_Check first! }
  210. BEGIN
  211.   Async_Read := Async_Buffer[Async_Buffer_Tail];
  212.   INC(Async_Buffer_Tail);
  213.   IF Async_Buffer_Tail > Async_Buffer_Max THEN
  214.     Async_Buffer_Tail := 0;
  215.   DEC(Async_Buffer_Used);
  216. END; { Async_Buffer_Check }
  217.  
  218. PROCEDURE Async_Send(c : CHAR);
  219. { transmit a character }
  220. BEGIN
  221.   PORT[Async_Base + Mcr] := $0B;                 {turn on OUT2, DTR, and RTS}
  222.   IF Async_CheckCTS THEN
  223.     WHILE (Port[Async_Base + Msr] AND $10) = 0 DO;  {wait for CTS}
  224.   WHILE (Port[Async_Base + Lsr] AND $20) = 0 DO; {wait for Tx Holding Reg Empty}
  225.   WHILE Async_Pause AND Async_CarrierDetect DO;  {wait for Xon}
  226.   DisableInterrupts;
  227.   PORT[Async_Base] := ORD(c);                    {send the character}
  228.   EnableInterrupts;
  229. END; { Async_Send }
  230.  
  231. PROCEDURE Async_Hangup;
  232. BEGIN
  233.   PORT[Async_Base+Mcr] := $00;  {dtr off}
  234.   DELAY(1000);                  {wait 1 second}
  235.   PORT[Async_Base+Mcr] := $03;  {dtr on}
  236. END;
  237.  
  238. FUNCTION Async_CarrierDetect : BOOLEAN;
  239. {true if carrier}
  240. VAR
  241.   b : BOOLEAN;
  242.   w : WORD;
  243. BEGIN
  244.   w:=0; b:=TRUE;
  245.   WHILE (w<500) AND b DO BEGIN              {make sure carrier stays down}
  246.     INC(w);                                 {and is not just a fluke     }
  247.     b:=(PORT[Async_Base+Msr] AND 128) <> 128; {true = no carrier};
  248.   END;
  249.   Async_CarrierDetect := NOT b;
  250. END;
  251.  
  252. BEGIN
  253.   Async_Init;
  254. END. { ASYNC UNIT }
  255.